home *** CD-ROM | disk | FTP | other *** search
- VERSION 5.00
- Begin VB.Form VBShellDlg
- BorderStyle = 3 'Fixed Dialog
- Caption = "Custom Solution Wizard Sample"
- ClientHeight = 4875
- ClientLeft = 2760
- ClientTop = 3750
- ClientWidth = 4980
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 4875
- ScaleWidth = 4980
- ShowInTaskbar = 0 'False
- Begin VB.CheckBox chkResetNetwork
- Caption = "Reset Network Before Training"
- Height = 255
- Left = 480
- TabIndex = 4
- Top = 960
- Width = 2655
- End
- Begin VB.CommandButton cmdTrainNetwork
- Caption = "Train Network"
- Height = 375
- Left = 240
- TabIndex = 2
- Top = 480
- Width = 1815
- End
- Begin VB.CommandButton cmdClose
- Caption = "Close"
- Height = 375
- Left = 1920
- TabIndex = 1
- Top = 4320
- Width = 1215
- End
- Begin VB.CommandButton cmdGetNetworkOutput
- Caption = "Get Network Output"
- Height = 375
- Left = 240
- TabIndex = 0
- Top = 1440
- Width = 1815
- End
- Begin VB.Frame Frame1
- Caption = "Press the buttons to run the sample functions"
- Height = 1215
- Left = 120
- TabIndex = 5
- Top = 120
- Width = 4695
- Begin VB.TextBox txtTrainNetwork
- Height = 375
- Left = 2160
- Locked = -1 'True
- TabIndex = 6
- Text = "Not Tested."
- Top = 360
- Width = 2415
- End
- End
- Begin VB.Frame Frame2
- Height = 2415
- Left = 120
- TabIndex = 7
- Top = 1200
- Width = 4695
- Begin VB.TextBox txtNetworkOutput
- BeginProperty Font
- Name = "Courier New"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 1575
- Left = 120
- Locked = -1 'True
- MultiLine = -1 'True
- ScrollBars = 3 'Both
- TabIndex = 8
- Text = "VBShellDlg.frx":0000
- Top = 720
- Width = 4455
- End
- End
- Begin VB.Label Label1
- Alignment = 2 'Center
- BorderStyle = 1 'Fixed Single
- Caption = "The sample functions associated with these buttons have been modified to work with your training data."
- Height = 495
- Left = 480
- TabIndex = 3
- Top = 3720
- Width = 4095
- End
- Attribute VB_Name = "VBShellDlg"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- Option Explicit
- Private Sub cmdClose_Click()
- Unload Me
- End Sub
- Private Sub Form_Load()
- resetNetwork = True
- chkResetNetwork.Value = vbChecked
- If RECALL_ONLY_NETWORK = True Then
- txtTrainNetwork.Text = "Recall Network Only."
- cmdTrainNetwork.Enabled = False
- chkResetNetwork.Enabled = False
- Else
- txtTrainNetwork.Text = "Not tested."
- End If
- txtNetworkOutput.Text = "Not tested."
- End Sub
- Private Sub cmdGetNetworkOutput_Click()
- 'Get the network response as an array of outputs
- Dim networkResponse As Variant
- networkResponse = GetNetworkResponse
- 'Clear contents of the list box
- txtNetworkOutput.Text = ""
- 'Get/Create the column labels for the output data
- Dim outputLabelsArray As Variant
- Dim i As Long
- If CheckIfFileOnFileSystem(DATA_PATH & "\", DESIRED_FILE_NAME) = True Then
- Dim outputLabels As String
- Open DATA_PATH & "\" & DESIRED_FILE_NAME For Input As #1
- Line Input #1, outputLabels
- Close #1
- outputLabelsArray = Split(outputLabels, Chr(9))
- Else
- ReDim outputLabelsArray(LBound(networkResponse, 2) To UBound(networkResponse, 2))
- For i = LBound(outputLabelsArray) To UBound(outputLabelsArray)
- outputLabelsArray(i) = "Output#" & i + 1
- Next i
- End If
- Dim numberOfTrailingSpaces As Integer
- Dim outStr As String
- outStr = "Exemplar#"
- For i = LBound(outputLabelsArray) To UBound(outputLabelsArray)
- numberOfTrailingSpaces = 9 - Len(outputLabelsArray(i))
- If (numberOfTrailingSpaces > 0) Then
- outStr = outStr & Chr(9) & outputLabelsArray(i) & Space(numberOfTrailingSpaces)
- Else
- outStr = outStr & Chr(9) & Left(outputLabelsArray(i), 9)
- End If
- Next i
- outStr = outStr & vbCrLf
- 'Prepare output data for display in text box. Limit to 1000 rows.
- Dim j As Long
- Dim maxRows As Long
- maxRows = IIf(UBound(networkResponse, 1) > 1000, 1000, UBound(networkResponse, 1))
- For i = LBound(networkResponse, 1) To UBound(networkResponse, 1)
- outStr = outStr & Format(i + 1, "00000") & " "
- For j = LBound(networkResponse, 2) To UBound(networkResponse, 2)
- outStr = outStr & Chr(9) & Format(networkResponse(i, j), "0.0000000")
- Next j
- outStr = outStr & vbCrLf
- Next i
- 'Display output data in text box
- txtNetworkOutput.Text = outStr
- End Sub
- Private Sub chkResetNetwork_Click()
- If chkResetNetwork.Value = vbChecked Then
- resetNetwork = True
- Else
- resetNetwork = False
- End If
- End Sub
- Private Sub cmdTrainNetwork_Click()
- txtTrainNetwork.Text = "Training..."
- txtTrainNetwork.Refresh
- Dim trainingBestCost As Variant
- trainingBestCost = TrainNetwork
- txtTrainNetwork.Text = "Best Cost = " & trainingBestCost
- End Sub
- Function CheckIfFileOnFileSystem(filePath As String, fileName As String) As Boolean
- 'Determine if a file with the given fileName exists in the given filePath
- On Error GoTo ErrorHandler
- Dim filePathName As String
- filePathName = filePath & fileName
- If StrComp(Dir(filePathName, vbNormal), fileName, vbTextCompare) <> 0 Then
- CheckIfFileOnFileSystem = False
- Else
- CheckIfFileOnFileSystem = True
- End If
- On Error GoTo 0
- Exit Function
- ErrorHandler:
- CheckIfFileOnFileSystem = False
- End Function
-